library(tidyverse, warn.conflicts = F)
library(rvest)
library(plotly)
library(cluster)
library(ggdendro)
library(tibble)
theme_set(theme_light())
source("plota_solucoes_hclust.R")

Tipos de filme de Angelina Jolie

Usaremos dados do Rotten Tomatoes sobre os filmes de Angelina Jolie.

O código abaixo lê a tabela no html da página do rottentomatoes.com, extrai, limpa e organiza os dados em um tibble (que é um subtipo de data.frame). Os atributos do conjunto de dados são a avaliação de cada filme, o seu título, o papel que atriz fez no filme, o box office e o ano de lançamento do filme.

library(rvest)
url = "https://www.rottentomatoes.com/celebrity/angelina_jolie/"
download.file(url, destfile = "scrapedpage.html", quiet=TRUE)

from_page <- read_html("https://www.rottentomatoes.com/celebrity/angelina_jolie/") %>% 
    html_node("#filmographyTbl") %>% # A sintaxe da expressão é de um seletor à lá JQuery: https://rdrr.io/cran/rvest/man/html_nodes.html 
    html_table(fill=TRUE) %>% # Faz parse
    as.tibble()

filmes = from_page %>% 
    filter(RATING != "No Score Yet", 
           `BOX OFFICE` != "-", 
           CREDIT != "Executive Producer") %>%
    mutate(RATING = as.numeric(gsub("%", "", RATING)), 
           `BOX OFFICE` = as.numeric(gsub("[$|M]", "", `BOX OFFICE`))) %>% 
    filter(`BOX OFFICE` >= 1) # Para não pegar filmes que ainda não foram lançados
## Warning in eval(substitute(expr), envir, enclos): NAs introduzidos por
## coerção

A intuição

Avaliação

Primeiramente iremos observar se podemos agrupar os dados utilizando apenas a intuição, visualizando se realmente existem grupos semelhantes entre si no nosso conjunto.

Por exemplo, observando as avaliações dos filmes:

filmes %>% 
    ggplot(aes(x = RATING)) + 
    geom_histogram(bins = 16, fill = "#a24fa8" ) + 
    geom_rug(color = "#aa61a1")

Podemos observar 4 grupos distintos ao visualizar o gráfico de avaliações dos filmes. Temos o primeiro grupo que é dos filmes com avaliação muito baixa, o segundo que condiz ao grupo que possui avaliação em torno dos 50 pontos, o terceiro que sempre está acima de 50 porém abaixo de 75 e o quarto grupo que é o de filmes com boas avaliações.

Por esse gráfico podemos concluir que a maioria dos filmes de Angelina apresentados na sua página do Rotten Tomatoes não são aclamados pela crítica, a maior parte deles não chega a ter 75 pontos em sua avaliação.

Renda

Para fazer o mesmo com a renda do filme (ou box office), observamos que uma escala linear ou logarítmica levam a conclusões diferentes, portanto optamos por usar a escala logarítmica já que ela considera apenas diferenças muito grandes entre os números e assim facilita o agrupamento quando temos valores muito altos e que variam bastante.

filmes %>% 
    ggplot(aes(x = `BOX OFFICE`)) + 
    geom_histogram(bins = 20, fill = "#6075af") + 
    geom_rug(color = "#2c3e6d")

Não é possível definir grupos intuitivamente quando consideramos a renda do filme em uma escala linear.

filmes %>% 
    ggplot(aes(x = `BOX OFFICE`)) + 
    geom_histogram(bins = 20, fill = "#7db8d1") + 
    scale_x_log10() + 
    geom_rug(color = "#466775")

Já quando utilizamos a escala logaritmica é possível definir 4 grupos, da esquerda para direita: os dos filmes que geraram lucro baixíssimo, filmes que geraram pouco lucro, filmes com lucro razoável, e filmes com lucro alto.

Diante desses gráficos podemos afirmar que filmes com Angelina Jolie tendem a ter uma renda de mediana para alta, sendo a maioria concentrada perto dos 100 mil dólares de box office.

Agrupamento

Para produzir uma solução de agrupamento precisamos de:

  • Definição de proximidade/distância entre pontos
  • Definição de proximidade/distância entre grupos ou grupos e pontos
  • Processo de agrupamento
  • Decidir quantos grupos existem

Depois vem o principal: avaliar e interpretar a solução. Agrupamento sempre dá um resultado. Nem sempre é útil.

Agrupamento com uma dimensão

Avaliação

Vamos agrupar os dados da maneira hierárquica aglomerativa levando em consideração a avaliação dos filmes. O algoritmo irá selecionar os filmes que mais se assemelham (levando em conta a sua avaliação) e juntá-los em grupos.

row.names(filmes) = NULL
agrupamento_h = filmes %>% 
    column_to_rownames("TITLE") %>% 
    select(RATING) %>%
    dist(method = "euclidian") %>% 
    hclust(method = "ward.D")
## Warning: Setting row names on a tibble is deprecated.
ggdendrogram(agrupamento_h, rotate = T, size = 2) + 
    geom_hline(yintercept = 45, colour = "red")

Cada junção é um passo do algoritmo. A altura na dendrograma em cada passo significa a dissimilaridade entre os pontos ou grupos juntados naquele passo.

Na medida que vamos aglomerando, as dissimilaridades nas junções tendem a ir aumentando caso haja estrutura de grupos. O ideal é obter grupos com pouca dissimilaridade, nesse caso é bom manter 3 grupos, pois a altura do dendograma aumenta bastante quando tentamos diminuir esse número, e mais grupos seriam desnecessários, pois causaria informações repetitivas.

Vejamos as soluções com diferentes números de grupos.

solucoes = tibble(k = 1:6)

atribuicoes = solucoes %>% 
    group_by(k) %>% 
    do(cbind(filmes, 
             grupo = as.character(cutree(agrupamento_h, .$k)))) 
## Warning in bind_rows_(x, .id): Unequal factor levels: coercing to character
atribuicoes %>% 
    ggplot(aes(x = "Filmes", y = RATING, colour = grupo)) + 
    geom_jitter(width = .02, height = 0, size = 2, alpha = .6) + 
    facet_wrap(~ paste(k, " grupos"))

Agora a solução com 3 grupos, que foi o que obtivemos como ideal:

solucoes = tibble(k = 3)

atribuicoes = solucoes %>% 
    group_by(k) %>% 
    do(cbind(filmes, 
             grupo = as.character(cutree(agrupamento_h, .$k)))) 

names(atribuicoes)[names(atribuicoes)=="RATING"] <- "Nota"

p <- atribuicoes %>% 
    ggplot(aes(x = "Filmes", y = Nota, colour = grupo, text = TITLE)) + 
    geom_jitter(width = .02, height = 0, size = 2, alpha = .6) + 
    facet_wrap(~ paste(k, " grupos"))

ggplotly(p, width = 800, height = 500)

Podemos visualizar 3 grupos distintos, onde o primeiro é composto de filmes cuja avaliação pela crítica se encontra perto de 75 pontos, o segundo possui filmes com avaliação entre 50 e 60 e o terceiro apresenta filmes com avaliação menor ou igual a 35. Podemos observar que os grupos foram semelhantes aqueles encontrados de maneira intuitiva.

Renda

Agora os grupos serão feitos considerando a renda dos filmes em escala logarítmica. Primeiro será criado o dendograma, nesse caso foi observado que 3 grupos também seria o ideal, apesar de que as dissimilaridades desses grupos são maiores do que as dos criados levando em consideração as avaliações dos filmes.

row.names(filmes) = NULL


agrupamento_h = filmes %>% mutate(`BOX OFFICE` = log(`BOX OFFICE`)) %>% 
    column_to_rownames("TITLE") %>% 
    select(`BOX OFFICE`) %>%
    dist(method = "euclidian") %>% 
    hclust(method = "ward.D")
## Warning: Setting row names on a tibble is deprecated.
ggdendrogram(agrupamento_h, rotate = T, size = 2) + 
    geom_hline(yintercept = 4.5, colour = "red")

Vejamos as soluções com diferentes números de grupos.

filmes %>% mutate(`BOX OFFICE` = log(`BOX OFFICE`)) %>% 
    plota_hclusts_1d("`BOX OFFICE`", linkage_method = "centroid", ks = 1:6) + 
    scale_y_log10()
## Warning: Setting row names on a tibble is deprecated.
## Warning in bind_rows_(x, .id): Unequal factor levels: coercing to character

Observamos que as soluções com 3 ou 4 grupos são boas soluções, que dividem bem os dados.

filmes %>% mutate(`BOX OFFICE` = log(`BOX OFFICE`)) %>% 
    plota_hclusts_1d("`BOX OFFICE`", linkage_method = "centroid", ks = 3:4) + 
    scale_y_log10()
## Warning: Setting row names on a tibble is deprecated.
## Warning in bind_rows_(x, .id): Unequal factor levels: coercing to character

Os primeiros grupos são compostos por filmes com box office mais elevado, enquanto os outros são grupos de filmes com renda mais baixa.

Silhouetas

Verificamos se um agrupamento é adequado (ou útil) observando seu gráfico de silhouetas.

Dada a distância média de um ponto para os demais do seu cluster(ou grupo) \(a(i)\) e a distância média do ponto para todos os demais do cluster mais próximo \(b(i)\), a largura da silhoueta de \(i\) é :

\[ s(i) := ( b(i) - a(i) ) / max( a(i), b(i) ) \]

1 significa uma boa atribuição para \(i\), 0 significa indefinição e \(-1\) significa que há outro cluster onde \(i\) estaria melhor alocado.

Abaixo mostraremos os gráficos de silhouetas do agrupamento feito levando em consideração a avalição dos filmes.

distancias = filmes %>% 
    select(RATING) %>%
    dist(method = "euclidean")

agrupamento_hs = filmes %>% 
    column_to_rownames("TITLE") %>%
    select(RATING) %>%
    dist(method = "euclidean") %>% 
    hclust(method = "complete")
## Warning: Setting row names on a tibble is deprecated.
cores = RColorBrewer::brewer.pal(4, "Set2")

plot(silhouette(cutree(agrupamento_hs, k = 4), distancias), col = cores, border = NA)

cores = RColorBrewer::brewer.pal(3, "Set3")

plot(silhouette(cutree(agrupamento_hs, k = 3), distancias), col = cores, border = NA)

Visualizando os gráficos de silhouetas podemos observar que a escolha de 3 grupos ao invés de 4 é justificada, pois os valores de (i) estão mais próximos de 1 do que se fosse utilizado um agrupamento com 4 clusters.

Duas dimensões

Primeiro apresentaremos o gráfico dos filmes considerando sua avaliação e renda:

p = filmes %>% 
    ggplot(aes(x = RATING, y = `BOX OFFICE`, label = TITLE)) + 
    geom_point(color = "#3ea366") 

ggplotly(p, width = 800, height = 500)

Agora será criado o dendograma, que usará um algoritmo para agrupar os filmes de acordo com o box office em escala logarítmica e a avaliação.

agrupamento_h_2d = filmes %>% 
    column_to_rownames("TITLE") %>%
    select(RATING, `BOX OFFICE`) %>% 
    mutate(`BOX OFFICE` = log10(`BOX OFFICE`)) %>% 
    mutate_all(funs(scale)) %>% 
    dist(method = "euclidean") %>% 
    hclust(method = "centroid")
## Warning: Setting row names on a tibble is deprecated.
ggdendrogram(agrupamento_h_2d, rotate = TRUE)

Como sempre, o algoritmo encontra grupos. Vamos visualizá-los:

filmes2 = filmes %>% mutate(`BOX OFFICE` = log10(`BOX OFFICE`))
plota_hclusts_2d(agrupamento_h_2d, 
                 filmes2, 
                 c("RATING", "`BOX OFFICE`"), 'TITLE',
                 linkage_method = "ward.D", ks = 1:6) + scale_y_log10()
## Warning in bind_rows_(x, .id): Unequal factor levels: coercing to character

Compararemos as silhouetas do agrupamento com 4 clusters e 5 clusters:

distancias = filmes %>% 
    column_to_rownames("TITLE") %>%
    select(RATING, `BOX OFFICE`) %>% 
    mutate(`BOX OFFICE` = log10(`BOX OFFICE`)) %>% 
    mutate_all(funs(scale)) %>% 
    dist(method = "euclidean")
## Warning: Setting row names on a tibble is deprecated.
cores = RColorBrewer::brewer.pal(4, "Set3")
plot(silhouette(cutree(agrupamento_h_2d, k = 4), distancias), col = cores, border = NA)

cores = RColorBrewer::brewer.pal(5, "Set2")
plot(silhouette(cutree(agrupamento_h_2d, k = 5), distancias), col = cores, border = NA)

Dessa forma temos que o (i) se encontra ligeiramente mais próximo de 1 quando se tem 5 grupos, por conta disso e por ser mais fácil de classifica-los assim usaremos esse agrupamento.

names(filmes)[names(filmes)=="BOX OFFICE"] <- "LogRenda"
names(filmes)[names(filmes)=="RATING"] <- "Avaliacao"

filmes2 = filmes %>% mutate(LogRenda = log10(LogRenda))

p1 <- plota_hclusts_2d(agrupamento_h_2d, 
                 filmes2, 
                 c("Avaliacao", "LogRenda"),
                 'TITLE',
                 linkage_method = "ward.D", ks = 5) + scale_y_log10()


ggplotly(p1, width = 800, height = 500)

Assim podemos dividir os filmes em que Angelina Jolie participou em 5 grupos.

  1. Alta renda e avaliação mediana ou mediocre, não são filmes aclamados pela crítica porém também não são ditos filmes ruins, no entanto eles possuem uma box office elevada, Maléfica (2014) e Sr. e Sra. Smith (2005) são exemplos de filmes que se encaixam bem nesse grupo, ambos tem avaliações mediocres, 50 e 59 respectivamente, porém suas rendas são elevadas, sendo maiores que $180M.

  2. Renda média e avaliação média ou mediocre. The Good Shepherd (2006), que possui avaliação de 54 pontos, e Changeling (2008), com avaliação de 64 pontos, são exemplos de filmes que pertencem a esse grupo, ambos possuem box office menor que 85M e maior que 35M.

  3. Filmes “ruins” de acordo com a crítica, todos possuem pontuação menor ou igual a 35, porém com renda elevada, sendo o menor box office de 65.8M. Entre eles estão Lara Croft Tomb Raider - A Origem da Vida (2003) e Lara Croft Tomb Raider (2001), ambos realmente são filmes considerados “ruins”, no entanto renderam muito por serem adaptações cinematográficas de uma franquia de jogos famosa até hoje, que é a de Tomb Raider.

  4. Filmes considerados “muito ruins”, com menos de 28 pontos em sua avaliação, a maioria estando abaixo de 22 pontos, e que também não foram sucesso de vendas. Seu maior box office foi de 34.6M. Entre os integrantes desse grupo estão Alexander (2004) e Taking Lives (2004).

  5. É composto por apenas um filme, que é um fracasso em sua avaliação e na sua renda. Beyond Borders (2003) possui uma avaliação de 14 pontos apenas e sua renda foi de 4.4M, sendo está a menor renda de qualquer filme com Angelina Jolie.